home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / ddj1190.arc / E_FLOYD.ASC < prev    next >
Text File  |  1990-10-27  |  18KB  |  480 lines
  1. _AN EXISTENTIAL DICTIONARY_
  2. by Edwin T. Floyd
  3.  
  4. [LISTING ONE]
  5.  
  6. {$A+,B-,D-,E-,F+,I+,L-,N-,O-,R-,S-,V+}
  7. Unit Dict;
  8. Interface
  9. { DICT.PAS dictionary object and methods to create and use a superimposed
  10.   code dictionary.  Copyright Edwin T. Floyd, 1990. }
  11.  
  12. Type
  13.   Dictionary = Object
  14.     DictArray : Pointer;  { Pointer to dictionary bit array }
  15.     DictCount : LongInt;  { Number of key entries in this dictionary }
  16.     DictSize : Word;      { Number of bytes in dictionary bit array }
  17.     DictBits : Byte;      { Number of bits per key entry }
  18.  
  19.     Constructor Init(MaxKeys : Word; BitsPerKey : Byte);
  20.     { Initialize dictionary, specify maximum keys and bits per key. }
  21.  
  22.     Constructor RestoreDictionary(FileName : String);
  23.     { Restore dictionary saved on disk by SaveDictionary }
  24.  
  25.     { Note: Use either Init or RestoreDictionary, not both. }
  26.  
  27.     Destructor Done;
  28.     { Release storage allocated to dictionary. }
  29.  
  30.     Function DictionarySize : Word;
  31.     { Returns number of bytes that will be written by SaveDictionary. }
  32.  
  33.     Procedure SaveDictionary(FileName : String);
  34.     { Save dictionary in a disk file. }
  35.  
  36.     Function InsertString(Var s : String) : Boolean;
  37.     { Insert string in dictionary; returns TRUE if string is already there. }
  38.  
  39.     Function StringInDictionary(Var s : String) : Boolean;
  40.     { Returns TRUE if string is in dictionary. }
  41.  
  42.     Function InsertBlock(Var Data; Len : Word) : Boolean;
  43.     { Insert block in dictionary; returns TRUE if block is already there. }
  44.  
  45.     Function BlockInDictionary(Var Data; Len : Word) : Boolean;
  46.     { Returns TRUE if block is in dictionary. }
  47.  
  48.     Function InsertHash(Hash : LongInt) : Boolean;
  49.     { Insert hash in dictionary; returns TRUE if hash is already there. }
  50.  
  51.     Function HashInDictionary(Hash : LongInt) : Boolean;
  52.     { Returns TRUE if hash is in dictionary. }
  53.  
  54.     Function EstError : Real;
  55.     { Returns estimated probability of error. }
  56.  
  57.     Function ActError : Real;
  58.     { Returns actual probability of error (slow, counts bits). }
  59.  
  60.   End;
  61.  
  62. Function DictionaryBytes(MaxKeys : LongInt; BitsPerKey : Byte) : LongInt;
  63. { Returns the size in bytes of the optimal dictionary bit table for the
  64.   indicated key and bit-per-key counts. }
  65.  
  66. Function DictHash(Var Data; Len : Word) : LongInt;
  67. { Hash data block to a positive long integer. }
  68.  
  69. Implementation
  70.  
  71. Const
  72.   MagicNumber = $E501205F; { Used to validate dictionary save file }
  73.   RandMult = 16807;        { =7**5; RandMult must be expressable in 16 bits.
  74.                            48271 may give better "randomness" (see ACM ref.) }
  75.   ShuffleBits = 3;
  76.   ShuffleShift = 16 - ShuffleBits;
  77.   ShufTableEnd = $FFFF Shr ShuffleShift;
  78.   HashSeed : Word = 26;    { Initial hash seed }
  79.   RandSeed : LongInt = 1;  { Random number seed: 0 < RandSeed < 2**31-1 }
  80.  
  81. Type
  82.   SaveFileHeader = Record
  83.   { Header for dictionary save file (all numbers are byte-reversed) }
  84.     Magic : LongInt;       { Magic number for validity test }
  85.     BitsCount : LongInt;   { Bits-per-key and entry count }
  86.     Size : Word;           { Size of dictionary bit map in bytes }
  87.   End;
  88.  
  89. Var
  90.   ShufTable : Array[0..ShufTableEnd] Of LongInt;
  91.   NextOut : Word;
  92.  
  93. Function IRand : LongInt;
  94. { Return next "minimal standard", 31 bit pseudo-random integer.  This function
  95.   actually computes (RandSeed * RandMult) Mod (2**31-1) where RandMult is
  96.   a 16 bit quantity and RandSeed is 32 bits (See Carta, CACM 1/90). }
  97. Inline(
  98.   $A1/>RandSeed+2/       {         mov     ax,[>RandSeed+2]}
  99.   $BF/>RandMult/         {         mov     di,>RandMult}
  100.   $F7/$E7/               {         mul     di}
  101.   $89/$C3/               {         mov     bx,ax}
  102.   $89/$D1/               {         mov     cx,dx}
  103.   $A1/>RandSeed/         {         mov     ax,[>RandSeed]}
  104.   $F7/$E7/               {         mul     di}
  105.   $01/$DA/               {         add     dx,bx}
  106.   $83/$D1/$00/           {         adc     cx,0 ; cx:dx:ax = Seed * Mult }
  107.   $D0/$E6/               {         shl     dh,1 ; split p & q at 31 bits }
  108.   $D1/$D1/               {         rcl     cx,1}
  109.   $D0/$EE/               {         shr     dh,1 ; cx = p, dx:ax = q }
  110.   $01/$C8/               {         add     ax,cx}
  111.   $83/$D2/$00/           {         adc     dx,0 ; dx:ax = p + q }
  112.   $71/$09/               {         jno     done}
  113.   $05/$01/$00/           {         add     ax,1 ; overflow, inc(p + q) }
  114.   $83/$D2/$00/           {         adc     dx,0}
  115.   $80/$E6/$7F/           {         and     dh,$7F ; limit to 31 bits }
  116.                          {done:}
  117.   $A3/>RandSeed/         {         mov     [>RandSeed],ax}
  118.   $89/$16/>RandSeed+2);  {         mov     [>RandSeed+2],dx}
  119.  
  120. Function Hash(Seed : LongInt; Var Data; Len : Word) : LongInt;
  121. { Hash a block of data into a random long integer.  This is actually
  122.   equivalent to the following:
  123.  
  124.      RandSeed := Seed;
  125.      Hash := 0;
  126.      For i := 1 To Len Do Hash := Hash + (IRand * (Data[i] + $FF00);
  127.      Hash := Hash AND $7FFFFFFF;
  128.      If Hash = 0 Then Inc(Hash);
  129.  
  130.   Overflow is ignored.  The seed is kept in registers; RandSeed is not
  131.   affected by this routine. }
  132. Inline(
  133.   $59/                   {      pop     cx     ; cx := len}
  134.   $5E/                   {      pop     si     ; bx:si := @data}
  135.   $5B/                   {      pop     bx}
  136.   $58/                   {      pop     ax     ; dx:ax := seed}
  137.   $5A/                   {      pop     dx}
  138.   $E3/$59/               {      jcxz    alldone}
  139.   $FC/                   {      cld}
  140.   $1E/                   {      push    ds}
  141.   $8E/$DB/               {      mov     ds,bx}
  142.   $55/                   {      push    bp}
  143.   $31/$DB/               {      xor     bx,bx}
  144.   $53/                   {      push    bx     ; zero accumulator}
  145.   $53/                   {      push    bx}
  146.   $89/$E5/               {      mov     bp,sp}
  147.                          {next:                ; for each byte of data...}
  148.   $51/                   {      push    cx}
  149.   $BF/>RandMult/         {      mov     di,>RandMult}
  150.   $89/$C3/               {      mov     bx,ax}
  151.   $89/$D0/               {      mov     ax,dx  ;   compute next seed}
  152.   $F7/$E7/               {      mul     di}
  153.   $93/                   {      xchg    ax,bx}
  154.   $89/$D1/               {      mov     cx,dx}
  155.   $F7/$E7/               {      mul     di}
  156.   $01/$DA/               {      add     dx,bx}
  157.   $83/$D1/$00/           {      adc     cx,0   ; cx:dx:ax = Seed * Mult}
  158.   $D0/$E6/               {      shl     dh,1   ; split p & q at 31 bits}
  159.   $D1/$D1/               {      rcl     cx,1}
  160.   $D0/$EE/               {      shr     dh,1   ; cx = p, dx:ax = q}
  161.   $01/$C8/               {      add     ax,cx}
  162.   $83/$D2/$00/           {      adc     dx,0   ; dx:ax = p + q}
  163.   $71/$09/               {      jno     noovfl}
  164.   $05/$01/$00/           {      add     ax,1   ; overflow, inc(p + q)}
  165.   $83/$D2/$00/           {      adc     dx,0}
  166.   $80/$E6/$7F/           {      and     dh,$7F ; limit to 31 bits}
  167.                          {noovfl:}
  168.   $89/$C3/               {      mov     bx,ax  ; save seed}
  169.   $89/$D1/               {      mov     cx,dx}
  170.   $AC/                   {      lodsb          ; get next byte + $FF00}
  171.   $B4/$FF/               {      mov     ah,$FF}
  172.   $89/$C7/               {      mov     di,ax}
  173.   $F7/$E1/               {      mul     cx     ; multiply by seed}
  174.   $97/                   {      xchg    ax,di}
  175.   $F7/$E3/               {      mul     bx}
  176.   $01/$FA/               {      add     dx,di}
  177.   $01/$46/$00/           {      add     [bp+0],ax ; accumulate}
  178.   $11/$56/$02/           {      adc     [bp+2],dx}
  179.   $89/$D8/               {      mov     ax,bx}
  180.   $89/$CA/               {      mov     dx,cx}
  181.   $59/                   {      pop     cx}
  182.   $E2/$B9/               {      loop    next   ;  until out of data}
  183.                          {;}
  184.   $58/                   {      pop     ax}
  185.   $5A/                   {      pop     dx}
  186.   $5D/                   {      pop     bp}
  187.   $1F/                   {      pop     ds}
  188.   $80/$E6/$7F/           {      and     dh,$7F}
  189.                          {alldone:}
  190.   $89/$C3/               {      mov     bx,ax}
  191.   $09/$D3/               {      or      bx,dx}
  192.   $75/$01/               {      jnz     exit}
  193.   $40);                  {      inc     ax}
  194.                          {exit:}
  195.  
  196. Procedure Shuffle;
  197. { Load the shuffle table }
  198. Begin
  199.   For NextOut := 0 To ShufTableEnd Do ShufTable[NextOut] := IRand;
  200.   NextOut := Word(IRand) Shr ShuffleShift;
  201. End;
  202.  
  203. Function SIRand : LongInt;
  204. { Return the next shuffled random number }
  205. Var
  206.   y : LongInt;
  207. Begin
  208.   y := ShufTable[NextOut];
  209.   ShufTable[NextOut] := IRand;
  210.   NextOut := Word(y) Shr ShuffleShift;
  211.   SIRand := y;
  212. End;
  213.  
  214. Function TestBit(Var BitArray; Size : Word; BitNo : LongInt) : Boolean;
  215. { Returns TRUE if indicated bit number, modulo size of bit array, is set.
  216.   Size is in bytes. }
  217. Inline(
  218.                          {; dx:ax := BitNo}
  219.   $58/                   {      pop     ax}
  220.   $5A/                   {      pop     dx}
  221.                          {; bl := bit mask}
  222.   $88/$C1/               {      mov     cl,al}
  223.   $80/$E1/$07/           {      and     cl,$07}
  224.   $B3/$80/               {      mov     bl,$80}
  225.   $D2/$EB/               {      shr     bl,cl}
  226.                          {; dx:ax := byte offset}
  227.   $D1/$EA/               {      shr     dx,1}
  228.   $D1/$D8/               {      rcr     ax,1}
  229.   $D1/$EA/               {      shr     dx,1}
  230.   $D1/$D8/               {      rcr     ax,1}
  231.   $D1/$EA/               {      shr     dx,1}
  232.   $D1/$D8/               {      rcr     ax,1}
  233.                          {; dx := byte offset}
  234.   $5F/                   {      pop     di}
  235.   $39/$D7/               {      cmp     di,dx}
  236.   $77/$0E/               {      ja      quickdiv}
  237.                          {; protect against overflow}
  238.   $89/$F9/               {      mov     cx,di}
  239.                          {protloop:}
  240.   $D1/$E1/               {      shl     cx,1}
  241.   $39/$D1/               {      cmp     cx,dx}
  242.   $76/$FA/               {      jbe     protloop}
  243.   $F7/$F1/               {      div     cx}
  244.   $89/$D0/               {      mov     ax,dx}
  245.   $31/$D2/               {      xor     dx,dx}
  246.                          {quickdiv:}
  247.   $F7/$F7/               {      div     di}
  248.                          {; es:di := seg:ofs of byte}
  249.   $5F/                   {      pop     di}
  250.   $01/$D7/               {      add     di,dx}
  251.   $07/                   {      pop     es}
  252.                          {; test bit}
  253.   $30/$C0/               {      xor     al,al}
  254.   $26/$22/$1D/           {      es:and  bl,[di]}
  255.   $74/$02/               {      jz      notset}
  256.   $FE/$C0);              {      inc     al}
  257.                          {notset:}
  258.  
  259. Function SetBit(Var BitArray; Size : Word; BitNo : LongInt) : Boolean;
  260. { Sets the indicated bit number modulo size of bit array.  Returns TRUE if
  261.   bit was already set.  Size is in bytes. }
  262. Inline(
  263.                          {; dx:ax := BitNo}
  264.   $58/                   {      pop     ax}
  265.   $5A/                   {      pop     dx}
  266.                          {; bl := bit mask}
  267.   $88/$C1/               {      mov     cl,al}
  268.   $80/$E1/$07/           {      and     cl,$07}
  269.   $B3/$80/               {      mov     bl,$80}
  270.   $D2/$EB/               {      shr     bl,cl}
  271.                          {; dx:ax := byte offset}
  272.   $D1/$EA/               {      shr     dx,1}
  273.   $D1/$D8/               {      rcr     ax,1}
  274.   $D1/$EA/               {      shr     dx,1}
  275.   $D1/$D8/               {      rcr     ax,1}
  276.   $D1/$EA/               {      shr     dx,1}
  277.   $D1/$D8/               {      rcr     ax,1}
  278.                          {; dx := byte offset mod size }
  279.   $5F/                   {      pop     di}
  280.   $39/$D7/               {      cmp     di,dx}
  281.   $77/$0E/               {      ja      quickdiv}
  282.                          {; protect against overflow}
  283.   $89/$F9/               {      mov     cx,di}
  284.                          {protloop:}
  285.   $D1/$E1/               {      shl     cx,1}
  286.   $39/$D1/               {      cmp     cx,dx}
  287.   $76/$FA/               {      jbe     protloop}
  288.   $F7/$F1/               {      div     cx}
  289.   $89/$D0/               {      mov     ax,dx}
  290.   $31/$D2/               {      xor     dx,dx}
  291.                          {quickdiv:}
  292.   $F7/$F7/               {      div     di}
  293.                          {; es:di := seg:ofs of byte}
  294.   $5F/                   {      pop     di}
  295.   $01/$D7/               {      add     di,dx}
  296.   $07/                   {      pop     es}
  297.                          {; test bit}
  298.   $30/$C0/               {      xor     al,al}
  299.   $88/$DC/               {      mov     ah,bl}
  300.   $26/$22/$25/           {      es:and  ah,[di]}
  301.   $74/$04/               {      jz      notset}
  302.   $FE/$C0/               {      inc     al}
  303.   $EB/$03/               {      jmp     short set}
  304.                          {notset:}
  305.   $26/$08/$1D);          {      es:or   [di],bl}
  306.                          {set:}
  307.  
  308. Function LongSwap(n : LongInt) : LongInt;
  309. { Reverse bytes in a LongInt. }
  310. Inline(
  311.   $5A/                   {      pop    dx}
  312.   $58/                   {      pop    ax}
  313.   $86/$C4/               {      xchg   ah,al}
  314.   $86/$D6);              {      xchg   dh,dl}
  315.  
  316. Function DictionaryBytes(MaxKeys : LongInt; BitsPerKey : Byte) : LongInt;
  317. Begin
  318.   DictionaryBytes := Round(MaxKeys * BitsPerKey / (-Ln(0.5) * 8));
  319. End;
  320.  
  321. Function DictHash(Var Data; Len : Word) : LongInt;
  322. Begin
  323.   DictHash := Hash(Hash(HashSeed, Data, Len), Data, Len);
  324. End;
  325.  
  326. Constructor Dictionary.Init(MaxKeys : Word; BitsPerKey : Byte);
  327. Var
  328.   DictBytes : LongInt;
  329. Begin
  330.   DictBytes := DictionaryBytes(MaxKeys, BitsPerKey);
  331.   If DictBytes > $FFF0 Then Begin
  332.     WriteLn(DictBytes, ' bytes optimal for dictionary, but ', $FFF0,
  333.       ' is maximum size dictionary.  Using max size.');
  334.     DictBytes := $FFF0;
  335.   End Else If DictBytes > MaxAvail Then Begin
  336.     WriteLn(DictBytes, ' bytes optimal for dictionary, but only ', MaxAvail,
  337.       ' bytes are available.  Using ', MaxAvail);
  338.     DictBytes := MaxAvail;
  339.   End Else If DictBytes < 16 Then DictBytes := 16;
  340.   DictSize := DictBytes;
  341.   GetMem(DictArray, DictSize);
  342.   FillChar(DictArray^, DictSize, 0);
  343.   DictCount := 0;
  344.   DictBits := BitsPerKey;
  345. End;
  346.  
  347. Constructor Dictionary.RestoreDictionary(FileName : String);
  348. Var
  349.   Header : SaveFileHeader;
  350.   DictBytes : LongInt;
  351.   f : File;
  352.   OldMode : Byte;
  353. Begin
  354.   OldMode := FileMode;
  355.   FileMode := $40;
  356.   Assign(f, FileName);
  357.   Reset(f, 1);
  358.   BlockRead(f, Header, SizeOf(Header));
  359.   With Header Do Begin
  360.     Magic := LongSwap(Magic);
  361.     Size := Swap(Size);
  362.     DictBytes := FileSize(f) - SizeOf(Header);
  363.     If (Magic <> MagicNumber) Or (Size <> DictBytes) Or (Size < 16)
  364.     Or (Size > $FFF0) Then Begin
  365.       WriteLn('File ', FileName, ' is not a dictionary save file.');
  366.       Halt(1);
  367.     End;
  368.     DictSize := Size;
  369.     DictBits := BitsCount And $FF;
  370.     DictCount := LongSwap(BitsCount And $FFFFFF00);
  371.     GetMem(DictArray, DictSize);
  372.     BlockRead(f, DictArray^, DictSize);
  373.     Close(f);
  374.     FileMode := OldMode;
  375.   End;
  376. End;
  377.  
  378. Destructor Dictionary.Done;
  379. Begin
  380.   FreeMem(DictArray, DictSize);
  381.   DictArray := Nil;
  382.   DictSize := 0;
  383.   DictBits := 0;
  384.   DictCount := 0;
  385. End;
  386.  
  387. Function Dictionary.DictionarySize : Word;
  388. Begin
  389.   DictionarySize := DictSize + SizeOf(SaveFileHeader);
  390. End;
  391.  
  392. Function Dictionary.InsertString(Var s : String) : Boolean;
  393. Begin
  394.   InsertString := InsertBlock(s[1], Length(s));
  395. End;
  396.  
  397. Function Dictionary.StringInDictionary(Var s : String) : Boolean;
  398. Begin
  399.   StringInDictionary := BlockInDictionary(s[1], Length(s));
  400. End;
  401.  
  402. Function Dictionary.InsertBlock(Var Data; Len : Word) : Boolean;
  403. Begin
  404.   InsertBlock := InsertHash(DictHash(Data, Len));
  405. End;
  406.  
  407. Function Dictionary.BlockInDictionary(Var Data; Len : Word) : Boolean;
  408. Begin
  409.   BlockInDictionary := HashInDictionary(DictHash(Data, Len));
  410. End;
  411.  
  412. Function Dictionary.InsertHash(Hash : LongInt) : Boolean;
  413. Var
  414.   i : Byte;
  415.   InDict : Boolean;
  416. Begin
  417.   InDict := True;
  418.   RandSeed := Hash;
  419.   Shuffle;
  420.   For i := 1 To DictBits Do
  421.     If Not SetBit(DictArray^, DictSize, SIRand) Then InDict := False;
  422.   If Not InDict Then Inc(DictCount);
  423.   InsertHash := InDict;
  424. End;
  425.  
  426. Function Dictionary.HashInDictionary(Hash : LongInt) : Boolean;
  427. Var
  428.   i : Byte;
  429.   InDict : Boolean;
  430. Begin
  431.   InDict := True;
  432.   RandSeed := Hash;
  433.   Shuffle;
  434.   i := 0;
  435.   While (i < DictBits) And InDict Do Begin
  436.     If Not TestBit(DictArray^, DictSize, SIRand) Then InDict := False;
  437.     Inc(i);
  438.   End;
  439.   HashInDictionary := InDict;
  440. End;
  441.  
  442. Procedure Dictionary.SaveDictionary(FileName : String);
  443. Var
  444.   Header : SaveFileHeader;
  445.   f : File;
  446. Begin
  447.   Assign(f, FileName);
  448.   ReWrite(f, 1);
  449.   With Header Do Begin
  450.     Magic := LongSwap(MagicNumber);
  451.     Size := Swap(DictSize);
  452.     BitsCount := LongSwap(DictCount) + DictBits;
  453.   End;
  454.   BlockWrite(f, Header, SizeOf(Header));
  455.   BlockWrite(f, DictArray^, DictSize);
  456.   Close(f);
  457. End;
  458.  
  459. Function Dictionary.EstError : Real;
  460. Begin
  461.   EstError := Exp(Ln(1.0-Exp(-(DictCount*DictBits)/(DictSize*8.0)))*DictBits);
  462. End;
  463.  
  464. Function Dictionary.ActError : Real;
  465. Var
  466.   AllBits, BitsOn, i : LongInt;
  467. Begin
  468.   AllBits := LongInt(DictSize) * 8;
  469.   BitsOn := 0;
  470.   For i := 0 To Pred(AllBits) Do
  471.     If TestBit(DictArray^, DictSize, i) Then Inc(BitsOn);
  472.   ActError := Exp(Ln(BitsOn / AllBits) * DictBits);
  473. End;
  474.  
  475. End.
  476.  
  477.  
  478.  
  479.  
  480.